# $Header: /mount/cvs-repository/Aligner/lib/perl/packs/CommentBlock.pm,v 1.1 2007/10/08 09:26:03 schweitz Exp $

package CommentBlock;

=head1 NAME

CommentBlock --- Extract and analyze comment block from the C++ source

=cut
#
#
#	@ --- keyword
#	NOTE:
#		indentation of key is removed in GetDesc
#		indentation of desc is removed in TexOut
#
#	    # Get info from CB
#		GetFlowTable
#		GetFlow
#		GetDesc
#		GetTitleList
#		GetTitle
#	    # CB related tools
#		ClearCBMark
#		TestCBMark
#		PrintCB
#	    # Extraction from source code
#		GetCommentBlocks
#	    # Text tools
#		Blank
#		CountIndent
#		ExpandLine
#		RemoveFollowingBlanks
#	    # Tools
#		Bye
#		Open
#
#	$Revision: 1.1 $
#	$Date: 2007/10/08 09:26:03 $
#	Author: ogawa@pdp.crl.sony.co.jp
#

use Desc;
use Cpp;

sub new {
    my $class = shift;
    my $file = shift;
    my $section = shift;
    my $base_indent = shift;
    my $cpp_status = shift;
    my $text = shift;
    my $mark = (split("\n", $text, 2))[0];

    $mark =~ s/^\s*([^\s]).*/$1/;
    #print "MARK $mark\n";
    $text =~ s/^(\s*)([^\s])(.*)/$1 $3/;
    #$text =~ s/$mark/ /;
    my(@a) = (1, 2, 3);

    my $this = {
	'file' => $file,
	'section' => $section,
	'base_indent' => $base_indent,
	'mark' => $mark,
	'cpp_status' => $cpp_status,
	'text' => $text,
	'title_pair' => new Desc,
	'pair' => new Desc(),
    };
    bless $this, $class;
    #$this->Parse();
    #$this;
}

sub DESTROY ($) {
    my $this = shift;
}

###############################################################################
#
#  GET INFO FROM COMMENT BLOCK (CB)
#
###############################################################################

#
#   Parse --- Decompose comment block into key-description hash table
#	In:
#	    $cb		comment block
#	return:
#	    (hash)
#	NOTE:
#	    Three digits index is inserted into key to ensure the order.
#	    E.g. key "NOTE" becomes "001NOTE". You need to remove the digits
#	    before display.
#
sub Parse {
    my($this) = shift;
	my($optl) = shift;
    my($cb) = $this->{text};
    #$this->{pair} = _get_desc($cb);
    $this->_get_desc($optl,$cb, $this->{pair});
    if ($this->{pair}->GetKey(0) eq '__HEAD_TEXT__') {
	  print STDERR "WARNING: Following text will be ignored\n";
	  print STDERR "======IGNORED TEXT BEGIN ===============\n";
	  print STDERR $this->{pair}->GetDesc('__HEAD_TEXT__');
	  print STDERR "======IGNORED TEXT END =================\n";
	$this->{pair}->Shift();
    }
    $this->{title_pair}->Add($this->{pair}->Shift());
    #$this->{title_pair}->Dump();
    #print join(',', @{$this->{keys}});
    #print "\n";
}

sub _get_desc {
  my $this = shift;
  my($optl) = shift;
  my($cb) = shift;
  my($pair) = shift;
  my($line);
  my($key) = '';
  my($desc) = '';
  my($idx) = 1;
  my($base_key_idt) = -1;
  my($cur_key_idt) = -1;
  my($tmp);
  my($foundkeydesc) = 0;
  #my($pair) = new Desc();
  $optl->{'debug'}{'Do'} and warn "--->cb = \"\n$cb\"\n";
  foreach $line (split("\n", $cb)) {
	#$line =~ s/^\s*//;
	if ($line =~ /.*\s+---(|[^-])/ || $line =~ /.*:($|\s+)/) {
	  $foundkeydesc = 1;
	  $optl->{'debug'}{'Do'} and warn "--->key = \"$key\"\n";
	  $optl->{'debug'}{'Do'} and warn "--->desc = \"\n$desc\"\n";
	  $optl->{'debug'}{'Do'} and warn "--->line = $line\n";
	  $cur_key_idt = &CountIndent($optl,$line);
	  $optl->{'debug'}{'Do'} and warn "--->IDT1=$cur_key_idt, $base_key_idt\n";
	  if ($base_key_idt < 0) {
		$base_key_idt = $cur_key_idt;
		if ($desc =~ /.*[^\s\n].*/) {
		  $optl->{'debug'}{'Do'} and warn "__HEAD_TEXT__:\n\"$desc\"\n";
		  $pair->Add('__HEAD_TEXT__', $desc);
		}
	  }
	  $optl->{'debug'}{'Do'} and warn "--->IDT2=$cur_key_idt, $base_key_idt\n";
	  if ($base_key_idt == $cur_key_idt) {
		if ($key ne '') {
		  #push(@{$this->{keys}}, $key);
		  #${$this->{descs}}{$key} = $desc;
		  #$this->{pair}->Add($key, $desc);
		  if ($key =~ m/\@$/) {
			$key =~ s/\@$//;
			$pair->Add($key, new Desc());
			$this->_get_desc($optl, $desc, $pair->GetDesc($key));
		  } else {
			$pair->Add($key, $desc);
		  }
		}
		if ($line =~ /.*\s+---(|[^-])/) {
		  ($key, $desc) = split('---', $line, 2);
		} else {
		  $line =~ s/:$/: /;
		  ($key, $desc) = split(/:\s+/, $line, 2);
		}
		$key =~ s/^\s+//;
		$key =~ s/\s+$//;
		#$desc =~ s/^\s+//;
		$desc .= "\n" if ($desc ne '');
	  } else {
		#print "===>$line\n";
		$desc .= "$line\n";
	  }
	} else {
	  $desc .= "$line\n";
	}
  }
  
  $optl->{'debug'}{'Do'} and warn "--->key final = \"$key\"\n";
  $optl->{'debug'}{'Do'} and warn "--->desc final= \"\n$desc\"\n";

  if ($key ne '') {
	if ($key =~ m/\@$/) {
	  $key =~ s/\@$//;
	  $pair->Add($key, new Desc());
	  $this->_get_desc($optl,$desc, $pair->GetDesc($key));
	} else {
	  #push(@{$this->{keys}}, $key);
	  #${$this->{descs}}{$key} = $desc;
	  #$this->{pair}->Add($key, $desc);
	  $pair->Add($key, $desc);
	}
  }

  if (not $foundkeydesc) {
	$cb =~ s/\n//g;$cb =~ s/^\s+//;$cb =~ s/\s+$//;
	$pair->Add($cb,'');
	$optl->{'debug'}{'Do'} and warn "--->No description, adding: $cb\n";
  }
}

###############################################################################
#
#  TEXT TOOLS
#
###############################################################################
#
#   Blank --- create blank of specified length
#	In:
#	    len		length of the blank
#
sub Blank {
    my($len) = @_;
    my($b) = '';

    while (--$len >= 0) {
	$b .= ' ';
    }
    $b;
}

#
#   CountIndent --- count depth of the indentation
#	In:
#	    line
#	return:
#	    the depth of the indentation that begin from 0.
#
sub CountIndent {
    my($optl,$line) = @_;
    my($indent) = 0;
    my($c) = 1;
    my(@lines);

    @lines = split("\n", $line);
    $line = $lines[0];			# get first line of the multi lines

    chop $line;
    $line =~ s/[^\s].*//;

    foreach $c (split('', $line)) {
	if ($c eq ' ') {
	    $indent++;
	} elsif ($c eq "\t") {
	    $indent -= $indent % $optl->{'TabStop'}{'string'};
	    $indent += $optl->{'TabStop'}{'string'};
	}
    }
    #$optl->{'debug'}{'Do'} and warn ">> -->$line<-- $indent\n";

    $indent;
}

###############################################################################
#
#  TEXT to COMMENT BLOCK (CB)
#
###############################################################################
#
#   GetCommentBlocks --- Cut '//' comment block
#	In:
#	    $file	file to read
#	Note:
#	    'header' is the first comment between top of the file 
#	    and begining of the class definition
#
#	    It is assumed that CLASS DEFINITION STARTHS WITH
#		/^class/
#	    AND END WITH
#		/^}/
#
sub GetCommentBlocks {    
    my($optl,$file) = @_;
    my @comments = ();
    my $comment = '';
    my $base_idt = -1;
    my $cur_idt;
    my $line;
    my $cur_section;
    my $prev_section;
    my $linen;
    my $mark;
    my $cpp = new Cpp();
    my $cpp_status;
    
    $prev_section = 'header';
    $cur_section = 'header';
    open(FH_COMMENT, "tr -d '\\015' <$file|") || die "$file: $!\n";# use tr for the DOS file

    #
    #	cur_idt have positive value only if current line is comment
    #	base_idt have positive value only if $comment having comment;
    #
    $linen = 0;
    while (<FH_COMMENT>) {

	++$linen;
	#
	#    section handing:
	#	header --- From the top of the file until class definition
	#	private
	#	public
	#	protected
	#
	#
	$prev_section = $cur_section;
	if (/^\s*private:/ || /^\s*protected:/ || /^\s*public:/) {
	    $cur_section = $_;
	    $cur_section =~ s/^\s*(.*):\s*/$1/;
	}
	if (/^class\s+[^;]*\s*$/) {	# opening class definition
	    $cur_section = 'private';
	}	# {
	if (/^};\s*/) {			# closing class definition
	    $cur_section = 'helper';
	}

	$optl->{'debug'}{'Do'} and warn ">$cur_section:$linen:$_";
	#
	#	pick up comments
	#
	$line = $_;
	$cur_idt = (/^\s*\/\//) ? &CountIndent($optl,$line) : -1;
	if ($base_idt < 0 && $cur_idt >= 0) {
	    $mark = (split("\n", $line, 2))[0];
	    $mark =~ s/\s*\/\/(.).*/$1/;
	}
	$line =~ s/(\s*)\/\//$1  /;
	if ($base_idt == $cur_idt && $cur_idt >= 0) {
	    $comment .= $line;
	} else {
	    if ($comment ne '') {
		$optl->{'debug'}{'Do'} and warn "MARK =====>'$mark'\n";
		$optl->{'debug'}{'Do'} and warn "COMMENT===>'\n$comment\n'\n";
		if ($mark eq '@' || $mark eq '#') {
		    push(@comments, new CommentBlock($file, $prev_section, $base_idt, $cpp->GetStatus(), $comment));
		}
		$comment = '';
	    }
	    $base_idt = $cur_idt;
	    $comment = $line if ($cur_idt >= 0);
	}
        # update ifdef status
        if ($line =~ /^#/) {
	    $cpp->Parse($line);
	}
    }
    if ($comment ne '') {
	if ($mark eq '@' || $mark eq '#') {
	    push(@comments, new CommentBlock($file, $cur_section, $base_idt, $cpp->GetStatus(), $comment));
	}
    }
    close(FH_COMMENT);

    return @comments;
}

1;
